home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / delite / paletti / paletti.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-01  |  10.4 KB  |  304 lines
  1. Program paletti;
  2. (*****************************************************************************
  3. Name:              PALETTI
  4. Version:           1.0
  5. Edit Datum:        1. März 1992
  6. Autor:             Andreas Schumm
  7. Kurzbeschreibung:  Palettendialog
  8. *****************************************************************************)
  9.  
  10. Uses API, Kernel, Dialogs;
  11.  
  12. CONST ProjektName  = 'paletti';
  13.  
  14. VAR   LaunchResult      : integer;
  15.       MyEvent           : EventTyp;
  16.       StillRunning      : boolean;
  17.  
  18. Type  ColorUserRadioButton = object(UserRadioButton)
  19.         constructor Init(x1,y1, dx,dy,xb,yb,TheID: Integer; col: byte; TheIcon: Pointer; nextB: PUserRadio);
  20.         procedure Draw; virtual;
  21.        private
  22.         MyColor : byte;
  23.       end;
  24.  
  25.       PColorRadio = ^ColorUserRadioButton;
  26.  
  27.  
  28.   constructor ColorUserRadioButton.Init;
  29.   begin
  30.     UserRadioButton.Init(x1,y1,dx,dy,xb,yb,theid,Theicon,nextB);
  31.     MyColor := col;
  32.   end;
  33.  
  34.  
  35.   procedure ColorUserRadioButton.Draw;
  36.   var lx,ly : integer;
  37.       col   : byte;
  38.   begin
  39.     With Area Do
  40.      if (not IsChecked) and ((status and sfMarked) = 0) then
  41.       begin
  42.         Rectangle(P1.x,P1.y,P2.x,P2.y, DlgItemColor);  { schwarzer Rahmen }
  43.         Line(P1.x+1,P1.y+1,P2.x-1,P1.y+1, DlgItemBkColor);  { weiss }
  44.         Line(P1.x+1,P1.y+2,P2.x-2,P1.y+2, DlgItemBkColor);
  45.         Line(P1.x+1,P1.y+1,P1.x+1,P2.y-1, DlgItemBkColor);
  46.         Line(P1.x+2,P1.y+1,P1.x+2,P2.y-2, DlgItemBkColor);
  47.         Bar(P1.x+3,P1.y+3,P2.x-3,P2.y-3,  MyColor);
  48.         Line(P1.x+2,P2.y-2,P2.x-1,P2.y-2, DlgButtonShadow);
  49.         Line(P1.x+1,P2.y-1,P2.x-1,P2.y-1, DlgButtonShadow);
  50.         Line(P2.x-1,P1.y+1,P2.x-1,P2.y-1, DlgButtonShadow);
  51.         Line(P2.x-2,P1.y+2,P2.x-2,P2.y-1, DlgButtonShadow);
  52.         lx := dxb div 2;
  53.         ly := dyb div 2;
  54.         if IconPtr <> NIL then
  55.         DrawNormIcon(P1.X + (P2.x-P1.x) div 2 - lx, P1.y + (P2.y-P1.y) div 2 - ly,
  56.                      dxb,dyb,0, DlgItemColor, IconPtr);
  57.       end
  58.     else
  59.       if IsChecked and ((status and sfMarked) = 0) then
  60.        begin
  61.          Rectangle(P1.x,P1.y,P2.x,P2.y, DlgItemColor);  { schwarzer Rahmen }
  62.          Line(P1.x+1,P1.y+1,P2.x-1,P1.y+1, DlgButtonShadow);
  63.          Line(P1.x+1,P1.y+1,P1.x+1,P2.y-1, DlgButtonShadow);
  64.          Bar(P1.x+2,P1.y+2,P2.x-1,P2.y-1,  MyColor);
  65.          lx := dxb div 2;
  66.          ly := dyb div 2;
  67.          If IconPtr <> NIL then
  68.          DrawNormIcon(P1.X + (P2.x-P1.x) div 2 - lx+1, P1.y + (P2.y-P1.y) div 2 - ly+1,
  69.                      dxb,dyb,0, DlgItemColor, IconPtr);
  70.        end
  71.     else
  72.      if (Status and sfMarked) <> 0 then
  73.       begin
  74.         Rectangle(P1.x,P1.y,P2.x,P2.y, DlgItemColor);  { schwarzer Rahmen }
  75.         Bar(P1.x+2,P1.y+2,P2.x-1,P2.y-1, MyColor);
  76.         Line(P1.x+1,P1.y+1,P2.x-1,P1.y+1, DlgButtonShadow);
  77.         Line(P1.x+1,P1.y+2,P2.x-2,P1.y+2, DlgButtonShadow);
  78.         Line(P1.x+1,P1.y+1,P1.x+1,P2.y-1, DlgButtonShadow);
  79.         Line(P1.x+2,P1.y+2,P1.x+2,P2.y-2, DlgButtonShadow);
  80.         lx := dxb div 2;
  81.         ly := dyb div 2;
  82.         If IconPtr <> NIL then
  83.          DrawNormIcon(P1.X + (P2.x-P1.x) div 2 - lx+2, P1.y + (P2.y-P1.y) div 2 - ly+2,
  84.                      dxb,dyb,0, DlgItemColor, IconPtr);
  85.       end;
  86.   End;
  87.  
  88.  
  89. procedure PaletteHandler(TheEvent: EventTyp); far;
  90. var MYDLG    : PDialog;
  91.     MyRadios : PUserRadios;
  92.     MySlider : PSlider;
  93.     color    : Byte;
  94.     r,g,b    : Byte;
  95. begin
  96.   MYDLG := TheEvent.DlgAdr;
  97.   If TheEvent.Class = DialogEvent then
  98.     Case TheEvent.MSG of
  99.       DLG_SLIDERMOVED :
  100.                     begin
  101.                       MySlider := MYDLG^.FindDlgItem(301);
  102.                       r := MySlider^.GetPos;
  103.                       MySlider := MYDLG^.FindDlgItem(302);
  104.                       g := MySlider^.GetPos;
  105.                       MySlider := MYDLG^.FindDlgItem(303);
  106.                       b := MySlider^.GetPos;
  107.                       MyRadios := MYDLG^.FindDlgItem(411);
  108.                       color := MyRadios^.WhosChecked-412;
  109.                       SetPalette(color,r,g,b);
  110.                     end;
  111.       DLG_OK     :  MYDLG^.DestroyDialog;
  112.       DLG_CANCEL :  begin
  113.                       MYDLG^.flags := MYDLG^.flags or MF_CANCELLED;
  114.                       MYDLG^.DestroyDialog;
  115.                     end;
  116.       DLG_BUTTON : if TheEvent.ID = 103 then { Standard gedrückt }
  117.                      begin
  118.                        SetCursor(LoadCursor(HourGlassCursor));
  119.                        SetPalette(0, 0, 0, 0);
  120.                        SetPalette(1, 0, 0,42);
  121.                        SetPalette(2, 0,42, 0);
  122.                        SetPalette(3, 0,42,42);
  123.                        SetPalette(4,42, 0, 0);
  124.                        SetPalette(5,42, 0,42);
  125.                        SetPalette(6,42,21, 0);
  126.                        SetPalette(7,42,42,42);
  127.                        SetPalette(8,21,21,21);
  128.                        SetPalette(9,21,21,63);
  129.                        SetPalette(10,21,63,21);
  130.                        SetPalette(11,21,63,63);
  131.                        SetPalette(12,63,21,21);
  132.                        SetPalette(13,63,21,63);
  133.                        SetPalette(14,63,63,21);
  134.                        SetPalette(15,63,63,63);
  135.                        SetCursor(LoadCursor(DefaultCursor));
  136.                      end;
  137.       DLG_RADIO :  begin
  138.                      MyRadios := MYDLG^.FindDlgItem(411);
  139.                      color := MyRadios^.WhosChecked-412;
  140.                      Bar(20,120,307,140,color);
  141.                      GetPalette(color,r,g,b);
  142.                      MySlider := MYDLG^.FindDlgItem(301);
  143.                      MySlider^.SetPos(r);
  144.                      MySlider := MYDLG^.FindDlgItem(302);
  145.                      MySlider^.SetPos(g);
  146.                      MySlider := MYDLG^.FindDlgItem(303);
  147.                      MySlider^.SetPos(b);
  148.                    end;
  149.     end;
  150. end;
  151.  
  152. procedure ReadPaletteFromIni;
  153. var i        : integer;
  154.     r,g,b    : longint;
  155.     rr,gg,bb : byte;
  156.     ws       : string[5];
  157. begin
  158.   SetCursor(LoadCursor(HourGlassCursor));
  159.   for i := 0 to 15 do
  160.    begin
  161.      str(i,ws);
  162.      GetPalette(i,rr,gg,bb);
  163.      if GetInitFileInteger('Palette','Color'+ws+'R',r) then rr := r;
  164.      if GetInitFileInteger('Palette','Color'+ws+'G',g) then gg := g;
  165.      if GetInitFileInteger('Palette','Color'+ws+'B',b) then bb := b;
  166.      SetPalette(i,rr,gg,bb);
  167.    end;
  168.   SetCursor(LoadCursor(DefaultCursor));
  169. end;
  170.  
  171.  
  172. procedure PaletteDialog;
  173. var MyDialog       : Dialog;
  174.     MySlider       : PSlider;
  175.     MyButton       : PButton;
  176.     MyUserRadios   : PUserRadios;
  177.     MyLabel        : PLabelText;
  178.     MyFrame        : PLabelFrame;
  179.     r,g,b          : Byte;
  180.     i              : Integer;
  181.     ws             : String[5];
  182.     MyBitsPerPlane : Byte;
  183.     MyMonoFlag     : Boolean;
  184.     MyColorSteps   : Integer;
  185. begin
  186.   MyBitsPerPlane := BitsPerPlane;
  187.  
  188.   If Not IsMono Then MyBitsPerPlane := MyBitsPerPlane div 3;
  189.  
  190.   MyColorSteps := Round(Exp(1.0 * MyBitsPerPlane * Ln(2))) - 1;
  191.  
  192.   MyDialog.Init(330,180, MF_CAPTION, PaletteHandler);
  193.   MyDialog.SetCaption('Farbpalette einstellen');
  194.  
  195.    new(MyUserRadios, Init(3,155,400,39,411,
  196.      new(PColorRadio, Init(  0, 0,39,19,39,39,412, 0,nil,
  197.      new(PColorRadio, Init( 40, 0,39,19,39,39,413, 1,nil,
  198.      new(PColorRadio, Init( 80, 0,39,19,39,39,414, 2,nil,
  199.      new(PColorRadio, Init(120, 0,39,19,39,39,415, 3,nil,
  200.      new(PColorRadio, Init(160, 0,39,19,39,39,416, 4,nil,
  201.      new(PColorRadio, Init(200, 0,39,19,39,39,417, 5,nil,
  202.      new(PColorRadio, Init(240, 0,39,19,39,39,418, 6,nil,
  203.      new(PColorRadio, Init(280, 0,39,19,39,39,419, 7,nil,
  204.      new(PColorRadio, Init(  0,20,39,19,39,39,420, 8,nil,
  205.      new(PColorRadio, Init( 40,20,39,19,39,39,421, 9,nil,
  206.      new(PColorRadio, Init( 80,20,39,19,39,39,422,10,nil,
  207.      new(PColorRadio, Init(120,20,39,19,39,39,423,11,nil,
  208.      new(PColorRadio, Init(160,20,39,19,39,39,424,12,nil,
  209.      new(PColorRadio, Init(200,20,39,19,39,39,425,13,nil,
  210.      new(PColorRadio, Init(240,20,39,19,39,39,426,14,nil,
  211.      new(PColorRadio, Init(280,20,39,19,39,39,427,15,nil,nil))))))))))))))))))))))))))))))))));
  212.   MyDialog.AddItem(MyUserRadios);
  213.  
  214.   MyUserRadios^.CheckButton(412);
  215.  
  216.   new(MyButton, Init(200, 20,110,24,101,'OK'));
  217.   MyDialog.AddItem(MyButton);
  218.   MyButton^.MakeDefaultItem;
  219.  
  220.   new(MyButton, Init(200, 50,110,24,102,'Abbruch'));
  221.   MyDialog.AddItem(MyButton);
  222.   MyButton^.MakeCancelItem;
  223.  
  224.   new(MyButton, Init(200, 80,110,24,103,'Standard'));
  225.   MyDialog.AddItem(MyButton);
  226.  
  227.   new(MyFrame, Init(20,20,130, 90,0,'Palette'));
  228.   MyDialog.AddItem(MyFrame);
  229.  
  230.   GetPalette(black,r,g,b);
  231.  
  232.   new(MyLabel, Init(30,30,0,'R'));
  233.   MyDialog.AddItem(MyLabel);
  234.   new(MySlider,Init(45,30,90,301,0,MyColorSteps,hor));
  235.   MySlider^.SetPos(r);
  236.   MyDialog.AddItem(MySlider);
  237.  
  238.   new(MyLabel, Init(30,55,0,'G'));
  239.   MyDialog.AddItem(MyLabel);
  240.   new(MySlider,Init(45,55,90,302,0,MyColorSteps,hor));
  241.   MySlider^.SetPos(g);
  242.   MyDialog.AddItem(MySlider);
  243.  
  244.   new(MyLabel, Init(30,80,0,'B'));
  245.   MyDialog.AddItem(MyLabel);
  246.   new(MySlider,Init(45,80,90,303,0,MyColorSteps,hor));
  247.   MySlider^.SetPos(b);
  248.   MyDialog.AddItem(MySlider);
  249.  
  250.   MyDialog.Show;
  251.   Bar(20,120,307,140,black);
  252.   MyDialog.DoDialog;
  253.   if MyDialog.WasNotCancelled then
  254.     begin
  255.       SetCursor(LoadCursor(HourGlassCursor));
  256.       for i := 0 to 15 do
  257.         begin
  258.           str(i,ws);
  259.           GetPalette(i,r,g,b);
  260.           SetInitFileInteger('Palette','Color'+ws+'R',r);
  261.           SetInitFileInteger('Palette','Color'+ws+'G',g);
  262.           SetInitFileInteger('Palette','Color'+ws+'B',b);
  263.         end;
  264.       SetCursor(LoadCursor(DefaultCursor));
  265.     end;
  266.   MyDialog.Done;
  267. end;
  268.  
  269.  
  270. Procedure HandleMsg(MyMessage: EventTyp); far;
  271. { Hier werden die Botschaften behandelt. }
  272. Begin
  273.   With MyMessage Do
  274.     Case Class Of
  275.       Menu    : begin
  276.                   Case MenuItemID of
  277.                      0       : StillRunning := false;
  278.                      100     : PaletteDialog;
  279.                   end;
  280.                 end;
  281.     end; { Case Class }
  282. End;
  283.  
  284.  
  285. Begin
  286.   StillRunning := true;
  287.   DebugOn;
  288.   LaunchResult := OpenMainApplication(HandleMsg,
  289.                                           APP_NOFONT,
  290.                                           ProjektName);
  291.  
  292.   If LaunchResult = 0 then
  293.   begin
  294.     ReadPaletteFromIni;
  295.     while StillRunning Do
  296.       begin
  297.         GetEvent(MyEvent);
  298.         DispatchMessage(MyEvent);
  299.       end;
  300.     CloseMainApplication;
  301.   end
  302.   Else
  303.     Writeln('Programm kann nicht gestartet werden. Fehler: ',LaunchResult);
  304. End.