Rech Prog pour graphismes éfficace - Page 1

Voilà, je voudrais savoir s'il y a vait un prog qui convertissait les images en 4 grays mais avec 8 nuances, ie qd on fait un quadrillage gris clair - gris foncé pour avoir une illusion d'une nuance de gris encore en +.

Par ex j'ai vu ca dans les sprites de Zenith.

ti-picture, sur le site de Dolstouf (je sais pu l'adresse)

Oki

Tu peux toujours essayer TiPaintPlus (... sur mon site ...)

Ouais, mais ti-paint plus ne fait pas le tramage.

heu perpso je m'en sert jamais

TI-picture c

Le trammage ca sert bien dans les grosses images...
Regardez le fon de ti-pang, sans ca ca aurait rien donne du tout.

C'est quoi le tramage ???

Pour faire une image gray4 qui imite un gray7 en faisant des trames/"damiers" de pixels

Ou est-ce que je pourrais avoir un exemple parce que je ne comprends pas très bien ce que vous voulez dire ???

L'image de fond de ti-pang...

Qui c'est qui l'a programmé Ti-Pang ???

J'ai mis au point une librairie de décompression de vidéos sur TI il y a quelque temps. L'image est tramée, et ça rend carrément mieux
Si tu veux un exemple je peux t'envoyer les sources de l'encodeur AMC2.

OK pourquoi pas

Le tramage de la vidéo est réalisé au début de la fonction TMain1.Timer1Timer

unit mainunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  MPlayer, Menus, ComCtrls, StdCtrls, ExtCtrls, Buttons, ImgList;

type
  TMain1 = class(TForm)
    MediaPlayer1: TMediaPlayer;
    MainMenu1: TMainMenu;
    Fichier1: TMenuItem;
    Ouvrirunevido1: TMenuItem;
    EnregistrerenAMCx1: TMenuItem;
    N1: TMenuItem;
    Quitter1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Timer1: TTimer;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Aide1: TMenuItem;
    Apropos1: TMenuItem;
    RadioButton3: TRadioButton;
    procedure FormShow(Sender: TObject);
    procedure Quitter1Click(Sender: TObject);
    procedure Ouvrirunevido1Click(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Preparer_Sortie;
    procedure Convertire_Image;
    procedure EnregistrerenAMCx1Click(Sender: TObject);
    procedure Apropos1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

const
  Periode = 111;

var
  Main1: TMain1;
  Conversion : Boolean;

  SortieD, SortieP, Sortie : TextFile;
  Image_P : array[0..1] of string;

  AppliPath, NomFilm : ShortString;
  NomSortieD, NomSortieP, NomSortie : string;

  Duree, Taille, Frames : LongWord;
  IndicProto, ChaineComp : string;
  BpS : Byte;

  Xmax, Ymax, LargEc, HautEc, DimBuf : Integer;
  ScreenRect : TRect;

  S1, S2, S3, S4, S5, S6 : Word;


implementation

{$R *.DFM}


uses ScreenUnit, TIUnit, ProgressForm, AProposUnit;


procedure TMain1.FormShow(Sender: TObject);
begin
  AppliPath:= ExtractFilePath(Application.ExeName);
  Left:= Screen.Width - Width - 20;
  Top:= 20;
  MediaPlayer1.Display:= Screen1;
  RadioButton1Click(Sender);
  TrackBar1Change(Sender);
end;


procedure TMain1.Quitter1Click(Sender: TObject);
begin
  Close;
end;


procedure TMain1.Ouvrirunevido1Click(Sender: TObject);
var I : Byte;
begin
  if not OpenDialog1.Execute then Exit;
  NomFilm:= ExtractFileName(OpenDialog1.FileName);
  I:= 1;
  while (NomFilm[I] <> #32) and (NomFilm[I] <> '.') do Inc(I);
  NomFilm:= Copy(NomFilm, 1, I-1);
  NomSortieD:= AppliPath + 'Film.d';
  NomSortieP:= AppliPath + 'Film.p';
  AssignFile(SortieD, NomSortieD);
  AssignFile(SortieP, NomSortieP);
  MediaPlayer1.FileName:= OpenDialog1.FileName;
  MediaPlayer1.Open;
  TrackBar2Change(Sender);
  MediaPlayer1.TimeFormat:= tfMilliseconds;
  Progress1.ProgressBar1.Max:= MediaPlayer1.Length;
end;


procedure TMain1.TrackBar2Change(Sender: TObject);
begin
  MediaPlayer1.DisplayRect:= Rect(0, 0,
                                  LargEc*TrackBar2.Position,
                                  HautEc*TrackBar2.Position);
end;


procedure TMain1.Timer1Timer(Sender: TObject);
var
  X, Y : Integer;
  Deci : Single;
  Pixel : Byte;
  Trame : Boolean;
begin
  if Conversion then
  begin
    MediaPlayer1.Pause;
    Timer1.Enabled:= False;
  end;

  Trame:= True;
  with TI1.Canvas do
  begin
    CopyRect(ScreenRect, Screen1.Canvas, ScreenRect);
    for Y:= 0 to Ymax do
    begin
      for X:= 0 to Xmax do
      begin
        Pixel:= Pixels[X, Y];
        if Pixel <= S1 then Pixels[X, Y]:= $00000000 else
        if Pixel <= S2 then if Trame then Pixels[X, Y]:= $00000000
                                     else Pixels[X, Y]:= $00505050 else
        if Pixel <= S3 then Pixels[X, Y]:= $00505050 else
        if Pixel <= S4 then if Trame then Pixels[X, Y]:= $00505050
                                     else Pixels[X, Y]:= $00A0A0A0 else
        if Pixel <= S5 then Pixels[X, Y]:= $00A0A0A0 else
        if Pixel <= S6 then if Trame then Pixels[X, Y]:= $00A0A0A0
                                     else Pixels[X, Y]:= $00FFFFFF else
                            Pixels[X, Y]:= $00FFFFFF;
        Trame:= not Trame;
      end;
      Trame:= not Trame;
    end;
  end;

  if Conversion then
  begin
    Convertire_Image;
    Inc(Frames);
    Duree:= ((10*Frames div 9) + 5) div 10;
    X:= (Taille-16) div Frames;
    Deci:= DimBuf / 4;
    Deci:= 100 - (100 / (Deci / X));

    with Progress1 do
    begin
      Label2.Caption:= IntToStr(Duree);
      Label5.Caption:= IntToStr(Taille div 1024);
      Label8.Caption:= IntToStr(Frames);
      Label12.Caption:= IntToStr(X);
      Label13.Caption:= Copy(FloatToStr(Deci), 1, 4);
      ProgressBar1.Position:= MediaPlayer1.Position;
    end;

    MediaPlayer1.Pause;
    Timer1.Interval:= Periode;
    Timer1.Enabled:= True;
  end;
end;


procedure TMain1.SpeedButton1Click(Sender: TObject);
begin
  if MediaPlayer1.FileName = '' then Exit;
  Conversion:= False;
  Timer1.Enabled:= True;
  MediaPlayer1.Play;
end;


procedure TMain1.SpeedButton2Click(Sender: TObject);
var
  I : Integer;
begin
  if MediaPlayer1.FileName = '' then Exit;
  Timer1.Enabled:= False;
  MediaPlayer1.Stop;
  MediaPlayer1.Rewind;
  if Conversion then
  begin
    I:= Length(IndicProto);
    if I > 0 then
    begin
      for I:= I to 7 do IndicProto:= IndicProto + '0';
      WriteLn(SortieP, #09'dc.b'#09'%', IndicProto);
      IndicProto:= '';
      Inc(Taille);
    end;

    I:= Length(ChaineComp);
    if I > 0 then
    begin
      for I:= I to 7 do ChaineComp:= ChaineComp + '0';
      WriteLn(SortieD, #09'dc.b'#09'%', ChaineComp);
      ChaineComp:= '';
      Inc(Taille);
    end;

    CloseFile(SortieD);
    CloseFile(SortieP);
 end;
  Progress1.Close;
  RadioButton1.Enabled:= True;
  RadioButton2.Enabled:= True;
  RadioButton3.Enabled:= True;
end;


procedure TMain1.SpeedButton3Click(Sender: TObject);
var
  I : Integer;
begin
  if MediaPlayer1.FileName = '' then Exit;
  RadioButton1.Enabled:= False;
  RadioButton2.Enabled:= False;
  RadioButton3.Enabled:= False;
  Progress1.Show;
  Duree:= 0;
  Taille:= 16;
  Frames:= 0;
  Preparer_Sortie;
  Image_P[0]:= '';
  for I:= 1 to (DimBuf div 4) do Image_P[0]:= Image_P[0] + '0000';
  Image_P[1]:= Image_P[0];
  Conversion:= True;
  MediaPlayer1.Play;
  Timer1.Interval:= Periode;
  Timer1.Enabled:= True;
end;


procedure TMain1.Preparer_Sortie;
begin
  IndicProto:= '';
  ChaineComp:= '';
  Rewrite(SortieD);
  Rewrite(SortieP);
end;


procedure TMain1.Convertire_Image;

  function Puissance(N : Integer; E : Byte) : Integer;
  var I : Byte;
  begin
    Result:= 1;
    for I:= 1 to E do Result:= Result * N;
  end;

  function IntToBin(N : Integer; Digits : Byte) : ShortString;
  var
    I : Byte;
    Np2 : Integer;
  begin
    // convertion d'un entier en nombre binaire de Digits chiffres
    Result:= '';
    for I:= Digits-1 downto 0 do
    begin
      Np2:= Puissance(2, I);
      if Np2 <= N then
      begin
        Dec(N, Np2);
        Result:= Result + '1';
      end else
        Result:= Result + '0';
    end;
  end;

  procedure Ajouter_Protocole(Proto : Char);
  begin
    IndicProto:= IndicProto + Proto;
    if Length(IndicProto) = 8 then
    begin
      WriteLn(SortieP, #09'dc.b'#09'%', IndicProto);
      IndicProto:= '';
      Inc(Taille);
    end;
  end;

  procedure Ajouter_Segment(Seg : string);
  begin
    ChaineComp:= ChaineComp + Seg;
    if Length(ChaineComp) = 8 then
    begin
      WriteLn(SortieD, #09'dc.b'#09'%', ChaineComp);
      ChaineComp:= '';
      Inc(Taille);
    end;
  end;

  procedure Mouline(var Moitie : string; BpS : Byte);
  var
    LongChaine, I, J, PosLec : Integer;
    BpR, NrepMax: Integer;
    Motif, Motif2 : ShortString;
  begin
    // compresse la chaine de chiffres binaires dans ChaineC

    BpR:= BpS div 2;
    NrepMax:= Puissance(2, BpR) + 1;
    PosLec:= 1;
    LongChaine:= Length(Moitie);

    repeat
      Motif:= Copy(Moitie, PosLec, BpR);
      Motif2:= Motif + Motif;

      I:= PosLec;
      if (I + (BpS*NrepMax)) > LongChaine then
        NrepMax:= (LongChaine - I) div 8;
      J:= 0;
      repeat
        Inc(I, BpS);
        Inc(J);
      until (Copy(Moitie, I, BpS) <> Motif2) or (J >= NrepMax);
      if J < 2 then
      begin
        Ajouter_Protocole('0');
        Ajouter_Segment(Copy(Moitie, PosLec, BpS));
        Inc(PosLec, BpS);
      end else
      begin
        Ajouter_Protocole('1');
        Ajouter_Segment(Motif + IntToBin(J-2, BpR));
        Inc(PosLec, BpS*J);
      end;
    until PosLec >= LongChaine;
  end;

var
  X, Y, I : Integer;
  Image_A : array[0..1] of string;
  ChaineO : string;
begin
  Image_A[0]:= '';
  Image_A[1]:= '';

  for Y:= 0 to Ymax do
    for X:= 0 to Xmax do
    begin
      case (TI1.Canvas.Pixels[X, Y] and $FF) of
        $00 : begin
                Image_A[0]:= Image_A[0] + '1';
                Image_A[1]:= Image_A[1] + '1';
              end;
        $50 : begin
                Image_A[0]:= Image_A[0] + '1';
                Image_A[1]:= Image_A[1] + '0';
              end;
        $A0 : begin
                Image_A[0]:= Image_A[0] + '0';
                Image_A[1]:= Image_A[1] + '1';
              end;
        $FF : begin
                Image_A[0]:= Image_A[0] + '0';
                Image_A[1]:= Image_A[1] + '0';
              end;
      end;
    end;

  ChaineO:= '';
  for I:= 1 to DimBuf do
  begin
    if (Image_P[0][I] = Image_A[0][I]) then
      ChaineO:= ChaineO + '0'
    else
      ChaineO:= ChaineO + '1';
  end;
  Mouline(ChaineO, BpS);

  ChaineO:= '';
  for I:= 1 to DimBuf do
  begin
    if (Image_P[1][I] = Image_A[1][I]) then
      ChaineO:= ChaineO + '0'
    else
      ChaineO:= ChaineO + '1';
  end;
  Mouline(ChaineO, BpS);

  Image_P[0]:= Image_A[0];
  Image_P[1]:= Image_A[1];
end;


procedure TMain1.EnregistrerenAMCx1Click(Sender: TObject);
var
  Ligne : string;
  I : Word;
begin
  if not FileExists(NomSortieD) then Exit;
  if not SaveDialog1.Execute then Exit;
  AssignFile(Sortie, SaveDialog1.FileName);
  Rewrite(Sortie);

  WriteLn(Sortie, NomFilm, 'AMCx:');
  WriteLn(Sortie, #09'dc.l'#09#39'AMCx'#39);
  WriteLn(Sortie, #09'dc.b'#09'20,', BpS);
  WriteLn(Sortie, #09'dc.w'#09, Frames);
  WriteLn(Sortie, #09'dc.b'#09, HautEc, ',', (LargEc div 8));
  WriteLn(Sortie, #09'dc.l'#09, Taille);

  Reset(SortieD);

  Reset(SortieP);                // astuce dégueulasse pour
  I:= 0;
  while not Eof(SortieP) do
  begin                          // compter le nombre d'octets
    ReadLn(SortieP, Ligne);
    Inc(I);
  end;                           // définis dans SortieP

  Reset(SortieP);

  WriteLn(Sortie, #09'dc.w'#09, I);

  while not Eof(SortieP) do
  begin
    ReadLn(SortieP, Ligne);
    WriteLn(Sortie, Ligne);
  end;
  WriteLn(Sortie);
  while not Eof(SortieD) do
  begin
    ReadLn(SortieD, Ligne);
    WriteLn(Sortie, Ligne);
  end;

  CloseFile(Sortie);
  CloseFile(SortieD);
  CloseFile(SortieP);
  DeleteFile(NomSortieD);
  DeleteFile(NomSortieP);
end;


procedure TMain1.Apropos1Click(Sender: TObject);
begin
  AProposDe1.Show;
end;


procedure TMain1.RadioButton1Click(Sender: TObject);
begin
  Xmax:= 159;
  Ymax:= 99;
  LargEc:= 160;
  HautEc:= 100;
  ScreenRect:= Rect(0, 0, 159, 99);
  DimBuf:= 160*100;
  TI1.ClientWidth:= 160;
  TI1.ClientHeight:= 100;
  Screen1.ClientWidth:= 160;
  Screen1.ClientHeight:= 100;
  BpS:= 8;
  TrackBar2Change(Sender);
end;


procedure TMain1.RadioButton2Click(Sender: TObject);
begin
  Xmax:= 79;
  Ymax:= 49;
  LargEc:= 80;
  HautEc:= 50;
  ScreenRect:= Rect(0, 0, 79, 49);
  DimBuf:= 80*50; 
  TI1.ClientWidth:= 80;
  TI1.ClientHeight:= 50;
  Screen1.ClientWidth:= 80;
  Screen1.ClientHeight:= 50;
  BpS:= 4;
  TrackBar2Change(Sender);
end;


procedure TMain1.RadioButton3Click(Sender: TObject);
begin
  Xmax:= 111;
  Ymax:= 71;
  LargEc:= 112;
  HautEc:= 72;
  ScreenRect:= Rect(0, 0, 111, 71);
  DimBuf:= 112*72;
  TI1.ClientWidth:= 112;
  TI1.ClientHeight:= 72;
  Screen1.ClientWidth:= 112;
  Screen1.ClientHeight:= 72;
  BpS:= 8;
  TrackBar2Change(Sender);
end;


procedure TMain1.TrackBar1Change(Sender: TObject);
begin
  S6:= 255 - 8*(TrackBar1.Max - TrackBar1.Position);
  S5:= S6 - 24;
  S4:= S5 - 24;
  S3:= S4 - 32;
  S2:= S3 - 48;
  S1:= S2 - 48;
end;


end.

au moins, c clair

comme je l'ai dit à je ne sais plus qui, le tramage, c le pointillisme moderne

c un procede qui utilise la synthese retinienne pour donner l'illusion qu'il y a + de nuances qu'il n'y en a en réalité.

Ca permet une "meilleure" def.

et Paxal, je te conseille de faire ceci :
convertit d'abord avec un prog normal ton img en 4 gris (je conseille http://www.irfanview.com), puis fais ta conversion bmp->*.h avec ti picture.

on arrive à un tres beau resultat.

oué

Attention : il ne faut pas abuser du trammage, en particulier sur le plan foncé en nuances de gris, ou sur le seul plan en noir et blanc, ceci a cause des 89HW2 en particulier.

Pourquoi ?
Bien essayez par exemple SMA, premier niveau, ou certains des murs sont une sorte de trammage sur le plan gris foncé.
Vous observerez une baisse tres importante du contraste.

Je ne sais pas si ca vient du processeur video ou de l'ecran, mais les 89HW2 sont tres merdiques.
On le voit aussi tres nettement dans le test constructeur de la 89, dans le LCD TEST, puis "1 bit checkerboard"... regardez le niveau du contraste, c'est horrible

d'ailleur si tu fait es lignes verticales (avec la fct shade en basic, pour aller + vite) tu vois ke le menu en haut de l'ecran graph par carrement en couille avec le contrast