ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Сохранить прозрачное png изображение
5 сообщений из 5, страница 1 из 1
Сохранить прозрачное png изображение
    #40027868
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Здравствуйте, не получается правильно сохранить прозрачное png изображение из Image.

Картинка сохраняется, но полностью прозрачной, подскажите где ошибка?

 
Код
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
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.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
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.
213.
214.
215.
216.
217.
218.
219.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtDlgs, Vcl.ExtCtrls,
  Vcl.Imaging.jpeg, Pngimage;

type
  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);
    procedure Button_1Click(Sender: TObject); // Загрузить изображение
    procedure Button_2Click(Sender: TObject); // Сохранить изображение

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  NewForm : TForm; // Новая форма
  Button_1,Button_2 : TButton;
  ScrollBox_1: TScrollBox;
  Image_1: TImage;
  OpenPictureDialog_1: TOpenPictureDialog;
  SavePictureDialog_1: TSavePictureDialog;
  oPictureDialog_1,sPictureDialog_1: string;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Button_1 := TButton.Create( Form1 );
 Button_2 := TButton.Create( Form1 );
 ScrollBox_1 := TScrollBox.Create( Form1 );
 Image_1 := TImage.Create( Form1 );
 OpenPictureDialog_1 := TOpenPictureDialog.Create( Form1 );
 SavePictureDialog_1 := TSavePictureDialog.Create( Form1 );

 with Form1 do // Свойства новой формы
  try
   Caption := '';
   Align:= alNone;
   Position:= poDesigned;
   BorderStyle := bsSingle;
   Height := 375;
   Width := 650;
   Left:=screen.Width div 2 - Width div 2;
   Top:=screen.Height div 2 - Height div 2;

   with Button_1 do
   begin
    Parent := Form1;
    Caption := 'Загрузить';
    Top := 295;
    Left:= 160;
    OnClick := Form1.Button_1Click;
   end;

   with Button_2 do
   begin
    Parent := Form1;
    Caption := 'Сохранить';
    Top := 295;
    Left:= 370;
    OnClick := Form1.Button_2Click;
   end;

   with ScrollBox_1 do
   begin
    Parent := Form1;
    Width := 380;
    Height := 280;
    Top := 10;
    Left:= 120;
    HorzScrollBar.Tracking := true;
    VertScrollBar.Tracking := true;
   end;

   with Image_1 do
   begin
    Parent := ScrollBox_1;
    AutoSize := true;
    Width := 100;
    Height := 100;
    Top := 0;
    Left:= 0;
   end;

   ActiveControl := Button_1; // Выделить кнопку
   Show;
  finally

  end;
end;


procedure TForm1.Button_1Click(Sender: TObject); // Загрузить изображение
var
JpegIm: TJpegImage;
png:TPngImage;
NewBitmap: TBitMap;
begin
  if (oPictureDialog_1='') then
  begin
   OpenPictureDialog_1.InitialDir :=  GetCurrentDir;
   oPictureDialog_1 := OpenPictureDialog_1.InitialDir;
  end
  else
  begin
   OpenPictureDialog_1.InitialDir := oPictureDialog_1;
  end;

 // OpenPictureDialog_1.Filter:= 'Text file|*.txt';
 //OpenPictureDialog_1.DefaultExt:=  'bmp';
 OpenPictureDialog_1.Filter:= '*';
 // OpenPictureDialog_1.FilterIndex:=  1;

 if OpenPictureDialog_1.Execute then
 begin
  Image_1.AutoSize := true;
  Image_1.Transparent := true;
  Image_1.Picture.Bitmap.Transparent := true;
  Image_1.Picture.Bitmap.TransparentMode:=tmFixed;
  Image_1.Picture.Bitmap.TransparentColor:=clWhite;
  Image_1.Picture.Bitmap.PixelFormat:=pf32bit;

  NewBitmap := TBitMap.Create;
  if ((ExtractFileExt(OpenPictureDialog_1.FileName)='.jpg') or
     (ExtractFileExt(OpenPictureDialog_1.FileName)='.jpeg')) then
  begin
   JpegIm := TJpegImage.Create;
   JpegIm.LoadFromFile(OpenPictureDialog_1.FileName);
   NewBitmap.Assign(JpegIm);
   Image_1.Picture.Bitmap.Assign(NewBitmap);
   JpegIm.Destroy;
  end
  else
  if (ExtractFileExt(OpenPictureDialog_1.FileName)='.png') then
  begin
   png:= TPNGObject.Create;
   png.Transparent := true;
   png.TransparentColor:=clBlack;
   png.LoadFromFile(OpenPictureDialog_1.FileName);

   NewBitmap.Assign(png);

   Image_1.Picture.Bitmap.TransparentColor:=clBlack;
   Image_1.Picture.Bitmap.Assign(NewBitmap);
   png.Destroy;
  end
  else
  if (ExtractFileExt(OpenPictureDialog_1.FileName)='.bmp') then
  begin
   NewBitmap.LoadFromFile(OpenPictureDialog_1.FileName);
   Image_1.Picture.Bitmap.Assign(NewBitmap);
  end;
  NewBitmap.Free;

  // Путь выбранного файла
  oPictureDialog_1 := ExtractFileDir(OpenPictureDialog_1.FileName);
 end;
end;


procedure TForm1.Button_2Click(Sender: TObject); // Сохранить изображение
var
i:integer;
png:TPngImage;
begin
  //SavePictureDialog_1.InitialDir:=  GetCurrentDir;
  if (sPictureDialog_1='') then
  begin
   if (oPictureDialog_1<>'') then
   begin
    SavePictureDialog_1.InitialDir := oPictureDialog_1;
   end
   else
   begin
    SavePictureDialog_1.InitialDir :=  GetCurrentDir;
    sPictureDialog_1 := SavePictureDialog_1.InitialDir;
   end
  end
  else
  begin
   SavePictureDialog_1.InitialDir := sPictureDialog_1;
  end;

 // SavePictureDialog_1.Filter:= 'Text file|*.txt';
  SavePictureDialog_1.DefaultExt:=  '';
 // SavePictureDialog_1.FilterIndex:=  1;

 if SavePictureDialog_1.Execute then
 begin
  //Image_1.Picture.Bitmap.SaveToFile(SavePictureDialog_1.FileName+'.png');

  png:= TPNGObject.Create;

  //png.TransparentColor := clBlack;
  //png.Assign(Image_1.Picture.Bitmap);

  png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, Image_1.Width, Image_1.Height);
  png.Draw(Image_1.Picture.Bitmap.Canvas, Rect(0,0,Image_1.Width, Image_1.Height));

  png.SaveToFile(SavePictureDialog_1.FileName+'.png');

  // Путь выбранного файла
  sPictureDialog_1 := ExtractFileDir(SavePictureDialog_1.FileName);
 end;
end;

end.

...
Рейтинг: 0 / 0
15.12.2020, 10:23
| Ответить | Цитировать | Написать  
Сохранить прозрачное png изображение
    #40029219
Cobalt747
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Cobalt747
Участник
сомневаюсь, что при сохранении из битапа что-то получится.
смотри в сторону TGraphic
...
Рейтинг: 0 / 0
19.12.2020, 10:39
| Ответить | Цитировать | Написать  
Сохранить прозрачное png изображение
    #40029250
Ученик_333
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ученик_333
Гость
Cobalt747
смотри в сторону TGraphic
Так сохранять загруженное изображение проще, спасибо.
Но вот как нарисовать допустим точку на этом png изображении и сохранить с прозрачностью, непонятно.
 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
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.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
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.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtDlgs, Vcl.ExtCtrls,
  Vcl.Imaging.jpeg, Pngimage;

type
  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);
    procedure Button_1Click(Sender: TObject); // Загрузить изображение
    procedure Button_2Click(Sender: TObject); // Сохранить изображение

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  NewForm : TForm; // Новая форма
  Button_1,Button_2 : TButton;
  ScrollBox_1: TScrollBox;
  Image_1: TImage;
  OpenPictureDialog_1: TOpenPictureDialog;
  SavePictureDialog_1: TSavePictureDialog;
  oPictureDialog_1,sPictureDialog_1,
  FileExt_1: string;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Button_1 := TButton.Create( Form1 );
 Button_2 := TButton.Create( Form1 );
 ScrollBox_1 := TScrollBox.Create( Form1 );
 Image_1 := TImage.Create( Form1 );
 OpenPictureDialog_1 := TOpenPictureDialog.Create( Form1 );
 SavePictureDialog_1 := TSavePictureDialog.Create( Form1 );

 with Form1 do // Свойства новой формы
  try
   Caption := '';
   Align:= alNone;
   Position:= poDesigned;
   BorderStyle := bsSingle;
   Height := 375;
   Width := 650;
   Left:=screen.Width div 2 - Width div 2;
   Top:=screen.Height div 2 - Height div 2;

   with Button_1 do
   begin
    Parent := Form1;
    Caption := 'Загрузить';
    Top := 295;
    Left:= 160;
    OnClick := Form1.Button_1Click;
   end;

   with Button_2 do
   begin
    Parent := Form1;
    Caption := 'Сохранить';
    Top := 295;
    Left:= 370;
    OnClick := Form1.Button_2Click;
   end;

   with ScrollBox_1 do
   begin
    Parent := Form1;
    Width := 380;
    Height := 280;
    Top := 10;
    Left:= 120;
    HorzScrollBar.Tracking := true;
    VertScrollBar.Tracking := true;
   end;

   with Image_1 do
   begin
    Parent := ScrollBox_1;
    AutoSize := true;
    Width := 100;
    Height := 100;
    Top := 0;
    Left:= 0;
   end;

   ActiveControl := Button_1; // Выделить кнопку
   Show;
  finally

  end;
end;


procedure TForm1.Button_1Click(Sender: TObject); // Загрузить изображение
var
png:TPngImage;
begin
  if (oPictureDialog_1='') then
  begin
   OpenPictureDialog_1.InitialDir :=  GetCurrentDir;
   oPictureDialog_1 := OpenPictureDialog_1.InitialDir;
  end
  else
  begin
   OpenPictureDialog_1.InitialDir := oPictureDialog_1;
  end;

 // OpenPictureDialog_1.Filter:= 'Text file|*.txt';
 //OpenPictureDialog_1.DefaultExt:=  'bmp';
 OpenPictureDialog_1.Filter:= '*';
 // OpenPictureDialog_1.FilterIndex:=  1;

 if OpenPictureDialog_1.Execute then
 begin
  Image_1.AutoSize := true;
  Image_1.Transparent := true;

  if ((ExtractFileExt(OpenPictureDialog_1.FileName)='.jpg') or
     (ExtractFileExt(OpenPictureDialog_1.FileName)='.jpeg')) then
  begin
   FileExt_1 := '.jpg';

   Image_1.Picture.Graphic := TJpegImage.Create;
   Image_1.Picture.Graphic.LoadFromFile(OpenPictureDialog_1.FileName);
  end
  else
  if (ExtractFileExt(OpenPictureDialog_1.FileName)='.png') then
  begin
   FileExt_1 := '.png';

   png:= TPngImage.Create;
   png.LoadFromFile(OpenPictureDialog_1.FileName);

   Image_1.Picture.Graphic := png;
   png.Destroy;
  end
  else
  if (ExtractFileExt(OpenPictureDialog_1.FileName)='.bmp') then
  begin
   FileExt_1 := '.bmp';

   Image_1.Picture.Graphic := TBitMap.Create;
   Image_1.Picture.Graphic.LoadFromFile(OpenPictureDialog_1.FileName);
  end;

  // Путь выбранного файла
  oPictureDialog_1 := ExtractFileDir(OpenPictureDialog_1.FileName);
 end;
end;


procedure TForm1.Button_2Click(Sender: TObject); // Сохранить изображение
//var
//png:TPngImage;
begin
  //SavePictureDialog_1.InitialDir:=  GetCurrentDir;
  if (sPictureDialog_1='') then
  begin
   if (oPictureDialog_1<>'') then
   begin
    SavePictureDialog_1.InitialDir := oPictureDialog_1;
   end
   else
   begin
    SavePictureDialog_1.InitialDir :=  GetCurrentDir;
    sPictureDialog_1 := SavePictureDialog_1.InitialDir;
   end
  end
  else
  begin
   SavePictureDialog_1.InitialDir := sPictureDialog_1;
  end;

 // SavePictureDialog_1.Filter:= 'Text file|*.txt';
  SavePictureDialog_1.DefaultExt:=  '';
 // SavePictureDialog_1.FilterIndex:=  1;

 if SavePictureDialog_1.Execute then
 begin
  //Image_1.Canvas.Brush.Color := clGreen;
  //Image_1.Canvas.FillRect(Rect(0,0,100,100));
  //Image_1.Picture.Bitmap.Canvas.Brush.Color := clGreen;
  //Image_1.Picture.Bitmap.Canvas.FillRect(Rect(0,0,100,100));

  Image_1.Picture.Graphic.SaveToFile(SavePictureDialog_1.FileName+FileExt_1);

  // Путь выбранного файла
  sPictureDialog_1 := ExtractFileDir(SavePictureDialog_1.FileName);
 end;
end;

end.

...
Рейтинг: 0 / 0
19.12.2020, 14:49
| Ответить | Цитировать | Написать  
Сохранить прозрачное png изображение
    #40029304
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
Не смотрел png-реализацию, но зная как в принципе устроена работа с графикой в VCL, рискну предположить что она не настолько умная, чтобы автоматически альфа-канал у PNG генерить.

Вот код, который точно работает:
 

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
procedure CreateFileWithLine(
          LineWidth, LineHeight: integer;
          PPM: double;
          const FileName: string);

const FillTemplate: cardinal=$FFFFFF;

var
  pngCLSID: TGUID;
  GP: TGPBitmap;
  PDatIn, PDatOut: pIntegerArray;
  LData: BitmapData;
  i,j: integer;
begin
  with TBitmap.Create do
  try
    Width:=LineWidth;
    Height:=LineHeight;
    PixelFormat:=pf32bit;

    //заполняем весь массив шаблонным цветом
    PDatIn:=ScanLine[Height-1];
    for i:=0 to Width*Height-1 do
      PDatIn[i]:=FillTemplate;

    //Вот тут стояла отрисовка объекта на канве битмапа

    GP:=TGPBitmap.Create(width,height, PixelFormat32bppARGB);
    try
      GP.LockBits(MakeRect(0,0,width, height),
                  ImageLockModeRead or ImageLockModeWrite,
                  PixelFormat32bppARGB, LData);

      try
        //задаем прозрачность для непустых пикселей
        for j:=0 to Height-1 do begin
          PDatIn:=ScanLine[j];
          PDatOut:=Pointer(cardinal(LData.Scan0)+J*Width*4);

          for i:=0 to Width-1 do
          if PDatIn[i]=FillTemplate
            then PDatOut[i]:=0
          else PDatOut[i]:=PDatIn[i] or $FF000000;
        end;
      finally
        GP.UnlockBits(LData);
      end;

      GetEncoderClsid('image/png',pngCLSID);
      GP.Save(FileName, pngCLSID,nil);
    finally
      GP.Free;
    end;
  finally
    Free;
  end;
end;


...
Рейтинг: 0 / 0
19.12.2020, 19:18
| Ответить | Цитировать | Написать  
Сохранить прозрачное png изображение
    #40029305
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
rgreat
Участник
У PNG бывает разная реализация прозрачности.

И через альфа-канал и через заднный индекс прозрачного цвета.
...
Рейтинг: 0 / 0
19.12.2020, 19:25
| Ответить | Цитировать | Написать  
5 сообщений из 5, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Сохранить прозрачное png изображение
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&gotonew=1&tid=2037772]:
 0ms
get settings:
 7ms
get forum list:
 13ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 188ms
get topic data:
 6ms
get first new msg:
 5ms
get forum data:
 2ms
get page messages:
 28ms
get tp. blocked users:
 1ms
others: 238ms
total:  494ms
созд. / загр.: 494ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]