Текущий архив: 2003.05.15;
Скачать: CL | DM;

Вниз

bmp(24bit) -> gif(4bit) (+)   Найти похожие ветки 

← →
Eugeny (r66)   (2003-02-05 10:43) [0]

...или как рисовать в bmp (4bit) с моими цветами (RGBs)

...необходимо сделать картинку - отчет с графиками для отправки эл.почтой...

---

← →
MBo   (2003-02-05 12:25) [1]

нужно создать 16-цветную палитру с нужными цветами

---

← →
Eugeny (r66)   (2003-02-05 12:38) [2]

Может я чего неправильно делаю?

Вырезка из кода:


const
g_ColorsCount : Integer = 15;

Type
spal : Record
lpal : logPalette;
dumm : array[0..15] of TColor;
End;

Var
gColors : Array[0..g_ColorsCount] of TColor; {Заполняется из фала}
bmp : TBitMap;
gif : TGifImage;

Procedure PaletteCreate;
Var
c : Integer;
sh : String;
Begin
spal.lpal.palVersion := $300;
spal.lpal.palNumEntries := 15;
For c := 0 to g_ColorsCount do
Begin
sh := IntToHex(GColors[2],8);
spal.lpal.palPalEntry[c].peFlags := StrToInt("$"+sh[1]+sh[2]);
spal.lpal.palPalEntry[c].peBlue := StrToInt("$"+sh[3]+sh[4]);
spal.lpal.palPalEntry[c].peGreen := StrToInt("$"+sh[5]+sh[6]);
spal.lpal.palPalEntry[c].peRed := StrToInt("$"+sh[7]+sh[8]);
End;
End;

Procedure TFGraphTable.DrowHeader;
Begin
bmp.Canvas.Brush.Color := GColors[g_clPaper];
// bmp.Canvas.Brush.Color := g_clPaper;
bmp.Width := 800;
bmp.Height := rh;
bmp.Canvas.Brush.Color := GColors[g_clCaption];
// bmp.Canvas.Brush.Color := g_clCaption;
SetBkMode(bmp.Canvas.Handle,TRANSPARENT);
bmp.Canvas.Font.Color := GColors[g_clText];
// bmp.Canvas.Font.Color := g_clText;
//№ п/п
bmp.Canvas.FillRect(Rect(1,1,39,rh));
bmp.Canvas.TextOut(Trunc((40-1)/2)-Trunc(bmp.Canvas.TextWidth("№ п/п")/2),Trunc((rh-1)/2)-Trunc(bmp.Canvas.TextHeight("№ п/п")/2),"№ п/п");
//=== Вырезано (аналогичные операции)
End;

Function CreatePic:Boolean;
Begin
bmp := TBitMap.Create;
bmp.PixelFormat := pf4bit;
Self.PaletteCreate;
bmp.PaletteModified := True;
FSplash.Show;
DrowHeader;
bmp.SaveToFile("sp.bmp");
bmp.Free;
Result := True;
FSplash.Hide;
FSplash.Free;
End;


---

← →
MBo   (2003-02-05 13:20) [3]

В твоем коде сразу не разберусь


procedure TForm1.Button1Click(Sender: TObject);
var b:TBitmap;
i:integer;
Colors16:array[0..15] of TRGBQuad;
BmpBits:array[0..32767] of byte;

function RGBQToCol(q:TRGBQuad):TColor;
begin
Result:=(Cardinal(q) and $ff00) or (Cardinal(q) and $ff shl 16) or
(Cardinal(q) and $ff0000 shr 16);
end;

begin
b:=TBitmap.Create;
b.width:=256;
b.height:=256;
b.PixelFormat:=pf4bit;
for i:=0 to 15 do
with Colors16[i] do begin
rgbRed:=16*i;
rgbGreen:=0;
rgbBlue:=0;
rgbReserved:=0;
end;
SetDIBColorTable(b.canvas.Handle,0,$10,Colors16);
for i:=0 to 15 do begin
b.Canvas.Brush.Color:=RGBQToCol(Colors16[i]);
b.canvas.rectangle(0,i shl 4,b.width,(i+1) shl 4);
end;
Canvas.Draw(10,10,b);


for i:=0 to 32767 do
BmpBits[i]:=((i shr 11) shl 4) or (i shr 11);
SetBitmapBits(b.Handle, sizeof(BmpBits),@BmpBits);
Canvas.Draw(310,10,b);
b.free;
end;


---

Страницы: 1 вся ветка

Текущий архив: 2003.05.15;
Скачать: CL | DM;

Наверх

Память: 0.45 MB
Время: 0.008 c