白黒2値のビットマップを白黒以外の色で表示するには？ (ID:28551)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんにちはKHE00221さん
こんなに早く回答をいただけるとは思いませんでした。

なのに・・・今日は1日現場仕事で留守にしていました。（現場の多い稼業です）
内容の理解はともかく、ボタンを追加し、頂いた例を貼り付け実行したところ、

[エラー] Unit1.pas(65): 未定義の識別子 : 'SetSize'

「SetSize」は、ナッキーの「Turbo Delphiはじめて奮戦記」ほか、あちこちに
解説がありそうですので、残業が済んだら体を温め、今晩勉強してみます。
結果を出すには時間が掛かりそうですが、ありがとうございました。

以下テスト----------------
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  BitMap : TBitMap;
  procedure ImageView(ViewBitmap: TBitmap);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
    BitMap.LoadFromFile(OpenDialog1.FileName);
    Form1.ImageView(Bitmap);

end;
end;

procedure TForm1.ImageView(ViewBitmap: TBitmap);
begin
  Image1.Height := ViewBitmap.Height;
  Image1.Width  := ViewBitmap.Width;
  Image1.Picture.Bitmap := ViewBitmap;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  BitMap := TBitMap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BitMap.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
//KHE00221さん
var
    PaletteEntries : array[0..1] of TRGBQUAD;
begin
    Image1.Picture.Bitmap.PixelFormat := pf1bit;
    Image1.Picture.Bitmap.SetSize(200,200);

Image1.Picture.Bitmap.Canvas.Brush.Color := $01000000;
    Image1.Picture.Bitmap.Canvas.FillRect(Rect(0,0,100,200));
    Image1.Picture.Bitmap.Canvas.Brush.Color := $01000001;
    Image1.Picture.Bitmap.Canvas.FillRect(Rect(100,0,200,200));

PaletteEntries[0].rgbBlue     := 255;
    PaletteEntries[0].rgbGreen    := 0;
    PaletteEntries[0].rgbRed      := 0;
    PaletteEntries[0].rgbReserved := 0;

PaletteEntries[1].rgbBlue     := 0;
    PaletteEntries[1].rgbGreen    := 0;
    PaletteEntries[1].rgbRed      := 255;
    PaletteEntries[1].rgbReserved := 0;

if SetDIBColorTable

(Image1.Picture.Bitmap.Canvas.Handle,0,2,PaletteEntries) = 0 then
    begin
      GetLastError;
    end
    else
    begin
      if DeleteObject(Image1.Picture.Bitmap.ReleasePalette) = Boolean(0) then
      begin
        GetLastError;
      end;
    end;

Image1.Invalidate;

end;
end.

←解決時は質問者本人がここをチェックしてください。

戻る